<%
'**************************************************
'HAVE_NOT_BYTES                      没有选择要上传的文件
'UPLOAD_DATA_OVER_MAXTOTALSIZE       上传文件总大小超过系统允许总大小
'SYSTEM_NONSUPPORT_ADODB_STREAM      系统不支持ADODB.STREAM
'FILE_OVER_MAXSIZE                   上传文件大小超过系统允许大小
'ILLEGAL_TYPE_OF_FILE                不允许上传此类文件
'GET_UPLOAD_DATA_ERROR               获取上传文件数据时发生错误
'HAVE_NOT_UPLOAD_ANY_FILE            没上传任何文件
'UPLOAD_FILES_OVER_THE_INCEPTMAXFILE 上传文件的个数超过系统允许一次上传的个数
'SAVETOFILE_ERROR                    保存文件时出错，检查路径是否正确或是否有有文件写入权限
'THIS_FILE_IS_NULL                   不存在该对象(如该文件没有上传,文件为空)
'**************************************************
Class Class_FileInfo
	Dim FormName,FileName,FilePath,FileSize,FileMIME,FileStart,FileExt
End Class
Class KnifeCMS_Class_Upload
	Dim Form,File
	Dim Pv_AllowExt	          '允许上传类型(白名单)
	Dim Pv_NoAllowExt     	  '不允许上传类型(黑名单)
	Dim Pv_IsDebug            '是否显示出错信息
	Private Pv_CharSet
	Private Pv_UploadPath         '设置保存的目录相对路径 String
	Private Pv_MaxSize            '设置单个上传文件大小上限 (单位：字节)
	Private Pv_MaxTotalSize       '设置所有上传文件总大小上限 (单位：字节)
	Private Pv_InceptMaxFile      '设置一次上传文件最大个数
	Private	Pv_ADODBStream        '上传的数据流
	Private Pv_IsError	     	  '是否有错（True/False）
	Private Pv_ErrMessage	      '错误的字符串信息
	Private Pv_IsHavedGetUploadData	      '指示是否已执行过GetUploadData过程
	
	Public Property Get IsError : IsError=Pv_IsError : End Property
	Public Property Get ErrMessage : ErrMessage=Pv_ErrMessage : End Property
	Public Property Get AllowExt : AllowExt=Pv_AllowExt : End Property
	Public Property Let AllowExt(Value) : Pv_AllowExt=LCase(Value) : End Property
	Public Property Get NoAllowExt : NoAllowExt=Pv_NoAllowExt : End Property
	Public Property Let NoAllowExt(Value) : Pv_NoAllowExt=LCase(Value) : End Property
	Public Property Let IsDebug(Value) : Pv_IsDebug=Value : End Property
	Public Property Let UploadPath(ByVal BV_Path) : Pv_UploadPath=BV_Path : End Property
	Public Property Get UploadPath() : UploadPath = Pv_UploadPath : End Property
	Public Property Let MaxSize(ByVal BV_Size) : Pv_MaxSize=BV_Size : End Property
	Public Property Get MaxSize() : MaxSize=Pv_MaxSize : End Property
	Public Property Let MaxTotalSize(ByVal BV_Size) : Pv_MaxTotalSize=BV_Size : End Property
	Public Property Get MaxTotalSize() : MaxTotalSize=Pv_MaxTotalSize : End Property
	Public Property Let InceptMaxFile(ByVal BV_Int) : Pv_InceptMaxFile=BV_Int : End Property
	Public Property Get InceptMaxFile() : InceptMaxFile=Pv_InceptMaxFile : End Property

	Private Sub Class_Initialize
		Pv_CharSet       = "gbk"
		Pv_MaxSize       = 2000*1024   '默认为2M
		Pv_MaxTotalSize  = 50000*1024  '默认为50M
		Pv_InceptMaxFile = 10          '默认允许一次上传6个
		Pv_IsError              = False
		Pv_IsHavedGetUploadData = False
	End Sub
	Private Sub Class_Terminate	
		On Error Resume Next
		Form.RemoveAll : Set Form = Nothing
		File.RemoveAll : Set File = Nothing
		Pv_ADODBStream.Close : Set Pv_ADODBStream = Nothing
		If Err.Number<>0 Then Err.Clear
	End Sub
	
	'取得并分析上传的数据
	Public Sub GetUploadData()
		On Error Resume Next
		If Pv_IsHavedGetUploadData=False Then 
			Dim Fn_TotalBytes,RequestBinDate,oFileInfo,bCrLf
			Dim iInfoStart,iInfoEnd,tStream,iStart
			Dim sSpace,sInfo,sFormName,sFormValue,sFileName,iFindStart,iFindEnd,iFormStart,iFormEnd
			Fn_TotalBytes = Request.TotalBytes
			If Fn_TotalBytes < 194 Then	'如果没有数据上传
				Pv_IsError = True : Pv_ErrMessage = "HAVE_NOT_BYTES" '没有数据上传,这是因为直接提交网址所产生的错误!
				Exit Sub
			End If
			If Fn_TotalBytes > Pv_MaxTotalSize Then
				Pv_IsError = True : Pv_ErrMessage = "UPLOAD_DATA_OVER_MAXTOTALSIZE"
				Exit Sub
			End If
			Set Form = Server.CreateObject ("Scripting.Dictionary")
			    Form.CompareMode = 1
			Set File = Server.CreateObject ("Scripting.Dictionary")
			    File.CompareMode = 1
			Set tStream = Server.CreateObject ("ADODB.Stream")
			Set Pv_ADODBStream = Server.CreateObject ("ADODB.Stream")
			If Err.Number<>0 Then
				Pv_IsError = True : Pv_ErrMessage = "SYSTEM_NONSUPPORT_ADODB_STREAM"  '创建流对象(ADODB.STREAM)时出错,可能系统不支持或没有开通该组件
				Exit Sub
			End If
			Pv_ADODBStream.Type = 1
			Pv_ADODBStream.Mode = 3
			Pv_ADODBStream.Open 
			Pv_ADODBStream.Write Request.BinaryRead(Fn_TotalBytes)'转成二进制
			Pv_ADODBStream.Position = 0
			RequestBinDate = Pv_ADODBStream.Read
			bCrLf = ChrB (13) & ChrB (10) '回车符{Enter}和换行符
			'取得每个项目之间的分隔符
			sSpace = MidB(RequestBinDate,1,InStrB(1,RequestBinDate,bCrLf)-1)
			iFormEnd   = Pv_ADODBStream.Size '字节总长度
			iStart     = LenB(sSpace)        '项目开始字节位置(包括分隔符)
			iFormStart = iStart+2            '项目开始字节位置(不包括分隔符)
			'分解项目
			Do While (iFormStart+2) < iFormEnd 
				iInfoEnd = InStrB (iFormStart,RequestBinDate,bCrLf & bCrLf)+3
				tStream.Type = 1
				tStream.Mode = 3
				tStream.Open
				Pv_ADODBStream.Position = iFormStart
				Pv_ADODBStream.CopyTo tStream,iInfoEnd-iFormStart
				tStream.Position = 0
				tStream.Type     = 2
				tStream.CharSet  = Pv_CharSet
				sInfo = tStream.ReadText			
				'取得表单项目名称
				iFormStart = InStrB (iInfoEnd,RequestBinDate,sSpace)-1
				iFindStart = InStr (22,sInfo,"name=""",1)+6
				iFindEnd   = InStr (iFindStart,sInfo,"""",1)
				sFormName  = Mid(sinfo,iFindStart,iFindEnd-iFindStart)
				'如果是文件
				If InStr(45,sInfo,"filename=""",1) > 0 Then
					Set oFileInfo = New Class_FileInfo
					'取得文件属性
					iFindStart = InStr (iFindEnd,sInfo,"filename=""",1)+10
					iFindEnd   = InStr (iFindStart,sInfo,""""&vbCrLf,1)
					sFileName  = Trim(Mid(sinfo,iFindStart,iFindEnd-iFindStart))
					oFileInfo.FilePath = GetFilePath(sFileName)
					oFileInfo.FileName = GetFileName(sFileName)
					oFileInfo.FileExt  = GetFileExt(sFileName)
					iFindStart         = InStr (iFindEnd,sInfo,"Content-Type: ",1)+14
					iFindEnd           = InStr (iFindStart,sInfo,vbCr)
					oFileInfo.FileMIME = Mid(sinfo,iFindStart,iFindEnd-iFindStart)
					oFileInfo.FileStart= iInfoEnd
					oFileInfo.FileSize = iFormStart -iInfoEnd -2
					oFileInfo.FormName = sFormName
					'如果不是空文件则添加一个文件字典
					If oFileInfo.FileSize>0 Then
						If IsAllowExt(oFileInfo.FileExt) Then
							If oFileInfo.FileSize > Pv_MaxSize Then
								Pv_IsError = True : Pv_ErrMessage = "FILE_OVER_MAXSIZE"
							Else
								File.Add sFormName,oFileInfo
							End If
						Else
							Pv_IsError = True : Pv_ErrMessage = "ILLEGAL_TYPE_OF_FILE"
						End If
					End If
					Set oFileInfo = Nothing
				Else
				'如果是表单项目
					tStream.Close
					tStream.Type = 1
					tStream.Mode = 3
					tStream.Open
					Pv_ADODBStream.Position = iInfoEnd 
					Pv_ADODBStream.CopyTo tStream,iFormStart-iInfoEnd-2
					tStream.Position = 0
					tStream.Type     = 2
					tStream.CharSet  = Pv_CharSet
					sFormValue = tStream.ReadText
					If Not(KnifeCMS.Data.IsNul(sFormValue)) Then
						If Form.Exists(sFormName) Then
							Form(sFormName) = Form (sFormName) &", "& sFormValue
						Else
							Form.Add sFormName,sFormValue
						End If
					End If
				End If
				tStream.Close
				iFormStart = iFormStart+iStart+2
				'如果到文件尾了就退出
			Loop
			If Err.Number<>0 Then 
				Pv_IsError = True : Pv_ErrMessage = "GET_UPLOAD_DATA_ERROR"  '分解上传数据时发生错误,可能客户端的上传数据不正确或不符合上传数据规则
				Exit Sub
			End If
			RequestBinDate = ""
			Set tStream    = Nothing
			Pv_IsHavedGetUploadData = True
		End if
		If Not(File.Count>0) Then
			If Pv_IsError<>True Then
				Pv_IsError    = True : Pv_ErrMessage = "HAVE_NOT_UPLOAD_ANY_FILE"
				Exit Sub
			End If
		End If
		If File.Count>Pv_InceptMaxFile Then
			Pv_IsError    = True
			Pv_ErrMessage = "UPLOAD_FILES_OVER_THE_INCEPTMAXFILE"
		End If
	End Sub
	
	'保存到文件,自动覆盖已存在的同名文件
	Public Function SaveFile(Item,BV_FileName)
		SaveFile=SaveToFile(Item,BV_FileName,True)
	End Function
	
	'保存到文件,自动设置文件名
	Public Function AutoSave(Item,BV_FileName)
		AutoSave=SaveToFile(Item,BV_FileName,False)
	End Function
	
	'保存到文件,BV_FileName不包含后缀名,BV_Overwrite为真时,自动覆盖已存在的同名文件,否则自动把文件改名保存
	Private Function SaveToFile(Item,BV_FileName,BV_Overwrite)
		On Error Resume Next
		Dim Fn_FileExt,oFileStream,Fn_Path,Fn_FoldPath,Fn_FilePath
		If File.Exists(Item) Then
			Pv_IsError = False
			Set oFileStream = CreateObject ("ADODB.Stream")
			oFileStream.Type = 1
			oFileStream.Mode = 3
			oFileStream.Open
			Pv_ADODBStream.Position = File(Item).FileStart
			'Echo "Pv_ADODBStream.Position:"& Pv_ADODBStream.Position &"<br>"
			Pv_ADODBStream.CopyTo oFileStream,File(Item).FileSize
			Pv_ADODBStream.Close : Set Pv_ADODBStream = Nothing
			Fn_FileExt=File(Item).FileExt
			'判断是否真实的图片(防止植入木马)
			If BV_Overwrite Then
				If IsAllowExt(Fn_FileExt) Then
					Fn_FilePath = Pv_UploadPath & BV_FileName &"."& Fn_FileExt 
					oFileStream.SaveToFile Fn_FilePath,2
					if Err.Number<>0 Then
						Pv_IsError = True : Pv_ErrMessage = "SAVETOFILE_ERROR"  '保存文件时出错,1.检查路径是否正确;2.检查是否有文件写入权限
						Exit Function
					Else
						If IsRealImageFile(Fn_FilePath)=False Then
							Call KnifeCMS.FSO.DeleteFile(Fn_FilePath)
							Pv_IsError = True : Pv_ErrMessage = "ILLEGAL_TYPE_OF_FILE"
						End If
					End if
				Else
					Pv_IsError = True : Pv_ErrMessage = "ILLEGAL_TYPE_OF_FILE"
					Exit Function
				End if
			Else
				Dim Fn_ii : Fn_ii=1
				if IsAllowExt(File(Item).FileExt) Then
					Do '如果不能保存文件则循环10次不同的文件名来保存
						Fn_ii=Fn_ii+1
						Err.Clear()
						Fn_FilePath = Pv_UploadPath & CreateFileName &"."& Fn_FileExt 
						oFileStream.SaveToFile Fn_FilePath
					Loop Until ((Fn_ii>10) Or (Err.Number=0))
					If Err.Number<>0 Then
						Pv_IsError = True : Pv_ErrMessage = "SAVETOFILE_ERROR"
						Exit Function
					Else
						If IsRealImageFile(Fn_FilePath)=False Then
							Call KnifeCMS.FSO.DeleteFile(Fn_FilePath)
							Pv_IsError = True : Pv_ErrMessage = "ILLEGAL_TYPE_OF_FILE"
						End If
					End if
				Else
					Pv_IsError = True : Pv_ErrMessage = "ILLEGAL_TYPE_OF_FILE"
					Exit Function
				End if
			End If
			oFileStream.Close
			Set oFileStream = Nothing
		Else
			Pv_IsError = True : Pv_ErrMessage = "THIS_FILE_IS_NULL" '"不存在该对象(如该文件没有上传,文件为空)!"
			Exit Function
		End If
		Err.Clear()
		If Pv_IsError Then
			SaveToFile = False
		Else
			SaveToFile = BV_FileName &"."& Fn_FileExt
		End If
	End Function
	
	Function IsRealImageFile(sFileName)
		Dim Fn_Result
		Dim jpg(1):jpg(0)=CByte(&HFF):jpg(1)=CByte(&HD8)
		Dim bmp(1):bmp(0)=CByte(&H42):bmp(1)=CByte(&H4D)
		Dim png(3):png(0)=CByte(&H89):png(1)=CByte(&H50):png(2)=CByte(&H4E):png(3)=CByte(&H47)
		Dim gif(5):gif(0)=CByte(&H47):gif(1)=CByte(&H49):gif(2)=CByte(&H46):gif(3)=CByte(&H39):gif(4)=CByte(&H38):gif(5)=CByte(&H61)
		On Error Resume Next
		Fn_Result=False
		Dim Fn_ADOStream,Fn_FileExt,Fn_Stamp,Fn_ii
		Fn_FileExt = LCase(GetFileExt(sFileName))
		'则执行真实图片判断
		If Fn_FileExt="jpg" Or Fn_FileExt="jpeg" Or Fn_FileExt="bmp" Or Fn_FileExt="gif" Or Fn_FileExt="png" Then
			Set Fn_ADOStream=Server.createobject("ADODB.Stream")
			Fn_ADOStream.Open
			Fn_ADOStream.Type= 1
			Fn_ADOStream.LoadFromFile sFileName
			Fn_ADOStream.position=0
			Select Case LCase(Fn_FileExt)
				Case "jpg","jpeg"
					Fn_Stamp=Fn_ADOStream.read(2)
					for Fn_ii=0 to 1
					If ascB(MidB(Fn_Stamp,Fn_ii+1,1))=jpg(Fn_ii) Then Fn_Result=True Else Fn_Result=False
					next
				Case "gif"
					Fn_Stamp=Fn_ADOStream.read(6)
					for Fn_ii=0 to 5
					If ascB(MidB(Fn_Stamp,Fn_ii+1,1))=gif(Fn_ii) Then Fn_Result=True Else Fn_Result=False
					next
				Case "png"
					Fn_Stamp=Fn_ADOStream.read(4)
					for Fn_ii=0 to 3
					If ascB(MidB(Fn_Stamp,Fn_ii+1,1))=png(Fn_ii) Then Fn_Result=True Else Fn_Result=False
					next
				Case "bmp"
					Fn_Stamp=Fn_ADOStream.read(2)
					for Fn_ii=0 to 1
					If ascB(MidB(Fn_Stamp,Fn_ii+1,1))=bmp(Fn_ii) Then Fn_Result=True Else Fn_Result=False
					next
			End Select
			Fn_ADOStream.Close
			Set Fn_ADOStream=Nothing
			If Err.Number<>0 Then Fn_Result = False
		Else
		   Fn_Result = True
		End If
		Err.Clear()
		IsRealImageFile = Fn_Result
	End Function
	
	'取得文件数据
	Public Function FileData(Item)
		Pv_IsError = False
		if File.Exists(Item) Then
			if IsAllowExt(File(Item).FileExt) Then
				Pv_ADODBStream.Position = File(Item).FileStart
				FileData = Pv_ADODBStream.Read (File(Item).FileSize)
			Else
				Pv_IsError = True : Pv_ErrMessage = "ILLEGAL_TYPE_OF_FILE"
				FileData=""
			End if
		Else
			Pv_IsError = True : Pv_ErrMessage = "THIS_FILE_IS_NULL"
		end if
	End Function
	
	'取得文件路径
	Public function GetFilePath(FullPath)
		If FullPath <> "" Then GetFilePath = Left(FullPath,InStrRev(FullPath, "\")) : Else GetFilePath = ""
	End function
	
	'取得文件名
	Public Function GetFileName(FullPath)
		If FullPath <> "" Then : GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1) : Else GetFileName = ""
	End function
	
	'取得文件的后缀名
	Public Function GetFileExt(FullPath)
		If FullPath <> "" Then GetFileExt = LCase(Mid(FullPath,InStrRev(FullPath,".")+1)) : Else GetFileExt = ""
	End function
	
	Public Function IsAllowExt(ByVAl BV_Ext)
		Dim Fn_ii,Fn_Array
		BV_Ext = LCase(BV_Ext)
		If NoAllowExt="" Then
			IsAllowExt = False
			Fn_Array   = Split(Pv_AllowExt,"|")
			For Fn_ii=0 To Ubound(Fn_Array)
				If BV_Ext=LCase(Fn_Array(Fn_ii)) Then IsAllowExt=True : Exit Function
			Next
		Else
			IsAllowExt = True
			Fn_Array   = Split(Pv_NoAllowExt,"|")
			For Fn_ii=0 To Ubound(Fn_Array)
				If BV_Ext=LCase(Fn_Array(Fn_ii)) Then IsAllowExt=False : Exit Function
			Next
		End If
	End Function
	
	'取得一个不重复的序号
	Public Function CreateFileName()
		CreateFileName = KnifeCMS.Data.FormatDateTime(SysTime,8) &"-"& KnifeCMS.MakeRandom(6)
	End Function
	
End Class

%>
